#!/usr/bin/perl
use strict;
use List::Util qw(min);
use Scalar::Util qw(reftype);
use Cwd qw(abs_path);
use File::Basename qw(dirname);

my $comment = q(
Milo's test generator
	parses a tex source and generates multiple variants from it
	
	recognizes options (put them in comments):
		!!file_prefix=<text>!!
		!!max_questions=<int>!!
		!!max_answers=<int>!!
		!!variants=<int>!!
		!!srand=<int>!!
	
	
	recognizes 
		\begin{test} - everything prior this will be preserved
		\end{test} - everything after this will be preserved
		\question... marks beggining of the question should not have anything prior it on the line.
			the question ends on next \question, or \end{test}
			\wrong - wrong answer. Becomes \postWrong in generated
			\correct - correct answer. Becomes \postCorrect in generated
		\startQuestion - alternative when \question causes problems
		
	
	replaces
		!!variant!! or !!v!!  - with variant number.
		!!note!! - note about version of the generator
		!!spacing!! - tabular-format LaTeX spacing for the answers table
		!!numbers!! - a row of numbers for the answers table
		!!boxes!! - a row of empty boxes for the answers table
		\tableExtra - with answer text
);

my $NOTE = "Generated by mest -0.9";

my $DIR = dirname(abs_path($0));

my $TEMPLATES = "$DIR/templates";

my $PDFLATEX = "TEXINPUTS=$TEMPLATES: pdflatex -halt-on-error -interaction=batchmode";
	
my %vars = (); #variables read from source

sub Rand{
	my $m = shift or warn;
	return int(rand($m));
}

# Knuth shuffle
sub Shuffle{
	my @a = @_;
	my $size = scalar @a;
	#warn $size;
	#warn $a[0];
	for(my $i = 0; $i < $size - 1; ++$i){
		my $j = $i + Rand ($size-$i);
		my $t = $a[$i];
		$a[$i] = $a[$j];
		$a[$j] = $t;
	}
	return @a;
}

sub GenQuestion{
	my @qsource = @{scalar shift} or warn;
	my $head = '';
	my $foot = '';
	my $state = 'pre'; #pre, post
	my @wrong = ();
	my @correct = ();
	foreach my $q(@qsource){
		#warn "got: $q";
		if($q =~ /^(\s)*\\wrong/){
			$state = 'post';
			push @wrong, $q;
		}
		elsif($q =~ /^(\s)*\\correct/){
			$state = 'post';
			push @correct, $q;
		}
		else{
			if($state eq 'pre'){
				$head .= $q;
			}
			elsif($state eq 'post'){
				$foot .= $q;
			}
			else {
				warn;
			}
		}
	}

	my @ans = ();
	my $correctIndex = -1;

	if (@wrong && @correct){
	    # question is closed, shuffle answers

	    @correct = Shuffle @correct;
	    @wrong = Shuffle @wrong;
	    #warn @correct;
	
	    $correct[0] or warn;
	    push @ans, $correct[0];
	    for(my $i = 0; $i < $vars{'max_answers'}-1 && $i < scalar @wrong; ++$i){
		push @ans, $wrong[$i];
	    }
	    @ans = Shuffle @ans;
	    
	    #warn "ans:@ans";
	    for(my $i = 0; $i < scalar @ans; ++$i){
		$correctIndex = $i if($ans[$i] =~ /^(\s)*\\correct/);
	    }

	    $correctIndex != -1 or warn;
	}

	# for open questions @ans stays () and $correctIndex stays -1
	my %res = (
	    'source' => $head. join('', @ans). $foot,
	    'ans' => $correctIndex
	    );
	return %res;
}
	
my $file_name = $ARGV[0];

$file_name or die "No filename given!";


	

my $head = ""; #header (prior \begin{test}, inclusive)
my $foot = ""; #footer (after \end{test}, inclusive)

#my @q = (); #$$wrong[question num][] 


my $buf = "";
my $state = 'pre'; # pre, body, que, post
my @questions = (); #array of questions
my @questions_buffer = (); #buffer of questions
my @qbuf = (); #current question

my $source;
open $source, $file_name;
while(<$source>){
	if(/\\begin\{test\}/){
		$state='body';
		$head .= $_;
	}
	elsif(/\\end\{test\}/){
		$state eq 'que' or $state eq 'body' or warn;
		if($state eq 'que'){
			#put previous question
			push @questions_buffer, \@qbuf;
			push @questions, @questions_buffer;
		}
		$state = 'post';
	}
	elsif($state ne 'pre' && (/^\s*\\question\W/ || /^\s*\\startQuestion\W/ || /^\s*\\openQuestion\W/)){
		if($state eq 'que'){
			#put previous question
			my @q = @qbuf;
			push @questions_buffer, \@q;
		}
		$state = 'que';
		@qbuf = ();
	}
	elsif($state ne 'pre' && (/^\s*\\startAlternatives\W/)){
		if($state eq 'que'){
			#put previous question
			my @q = @qbuf;
			push @questions_buffer, \@q;
			push @questions, @questions_buffer;
		}
		$state = 'alt';
		@qbuf = ();
		@questions_buffer = ();
	}
	elsif($state ne 'pre' && (/^\s*\\finishAlternatives\W/)){
		if($state eq 'que'){
			#put previous question
			my @q = @qbuf;
			push @questions_buffer, \@q;
		}
		my @qb = Shuffle @questions_buffer;
		push @questions, \@qb;
		$state = 'body';
		@qbuf = ();
		@questions_buffer = ();
	}
	
	if($state eq 'pre'){
		$head .= $_;
	}
	elsif($state eq 'que'){
		push @qbuf, $_;
	}
	elsif($state eq 'post'){
		$foot .= $_;
	}
}
close $source;

# default random seed (chosen randomly by mil0)
$vars{'srand'} = 5;
while($head =~ /!!(\w+)=([^!]+)!!/g){
	print "$1=$2\n";
	$vars{$1}=$2;
}

# initialize random seed
srand($vars{'srand'});

print "template directory: $TEMPLATES\n";

my $qc = scalar @questions;
print "found $qc questions\n";

my $vc = $vars{'variants'};
print "will generate $vc variants\n";

# effective question count
my $eqc = min $qc, $vars{'max_questions'};
print "will use $eqc questions\n";

my $numbersText = join '&', (1..$eqc);
my $columnsText = "\\columnFormat" x ($eqc+1);

my @letters = (
	'а', 'б', 'в', 'г', 'д', 'е', 'ж', 'з', 'и', 'й', 
	'к', 'л', 'м', 'н', 'о', 'п', 'р', 'с', 'т', 'у', 
	'ф', 'х', 'ц', 'ч', 'ш', 'щ', 'ъ', 'ь', 'ю', 'я'
);

my @ansRows = ();

#if you dont like this behaviour modify it ot make it customizable:
mkdir('out');
system "cp * out/";
chdir('out');

my @shuffleAlternatives = Shuffle (0..$vc-1);

for(my $variant = 1; $variant <= $vc; ++$variant){
	my $v = sprintf("%02d", $variant);
	print "variant: $v\n";
	
	my $fn = $vars{'file_prefix'}.$v.".tex";
	print "$fn\n";
	
	
	my $body = $head;
	
	my @shuffle = Shuffle (0..$qc-1);
	my @ans   = ($v);
	my @boxes = ("");
	
	for(my $i = 0; $i < $eqc ; ++$i){
		my @q = @{$questions[$shuffle[$i]]};
		if (reftype $q[0])
		{
		    # this is a set of alternatives, choose one
		    #print "From " . scalar @q . " alternatives ";
		    # if we have more alternatives than variants, shuffle
		    # else, choose at random
		    my $alt = @q >= $vc ? $shuffleAlternatives[$variant-1] % @q
					: Rand (scalar @q);
		    @q = @{$q[$alt]};
		    #print "chose @q";
		}
		my %r = GenQuestion \@q;
		$body .= $r{'source'};
		push @boxes, ($r{'ans'} == -1 ? "[X]" : "");
		push @ans  , ($r{'ans'} == -1 ? "X"   : $letters[$r{'ans'}]);
		#print $letters{$r{'ans'}};
		#print "$q ";
		#print @{$questions[$q]};
		#print "\n";
		#print %r;
		
	}
	
	push @ansRows, (join('&', @ans)."\\\\\n"."\\hline\n");
	print "\n";
	
	$body .= $foot;
	# post process - replace here ...
	
	$body =~ s/!!variant!!/$v/g;
	$body =~ s/!!v!!/$v/g;
	$body =~ s/!!note!!/$NOTE/g;
	$body =~ s/([^{])\\correct/$1\\postCorrect/g;
	$body =~ s/([^{])\\wrong/$1\\postWrong/g;
	$body =~ s/!!spacing!!/$columnsText/g;
	$body =~ s/!!numbers!!/$numbersText/g;
	my $boxesText = join '&\\ts', @boxes;
	$body =~ s/!!boxes!!/$boxesText/g;

	my $file;
	open $file, ">$fn";
	print $file $body;
	close $file;
	
	system "$PDFLATEX $fn > log";
	# run pdflatex once more to give it a chance to fix crossrefs
	system "$PDFLATEX $fn >> log";
}


my $body = $head;
$body .= "\\item :p\n";
$body .= $foot;

my $ansText = "\\hline\n".(join '', @ansRows);
$body =~ s/\\tableExtra/$1$ansText/g;
$body =~ s/!!note!!/$NOTE/g;
$body =~ s/!!spacing!!/$columnsText/g;
$body =~ s/!!numbers!!/$numbersText/g;
my $boxesText = '&\\ts' x $eqc;
$body =~ s/!!boxes!!/$boxesText/g;

my $fn = $vars{'file_prefix'}.'answers.tex';
print "answers: $fn\n";
my $file;
open $file, ">$fn";
print $file $body;
close $file;

system "$PDFLATEX $fn > log";
